home *** CD-ROM | disk | FTP | other *** search
/ Power CD / Power CD ATARI-Rechner Lieben.iso / UTILITY / ST_HERC / SLIDE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-06-16  |  2.8 KB  |  133 lines
  1. Program Slide_Show;
  2.  
  3. { Bringt eine Serie von Hercules-Bildern nacheinander auf den Bildschirm. }
  4. { Die Dateinamen der Bilder sind in der Datei INHALT abgelegt.            }
  5.  
  6.  
  7. {$C-}
  8. {$U-}
  9.  
  10.  
  11. Const GrafBase = $B000;
  12.  
  13.  
  14. Type strg40 = string [40];
  15.  
  16.  
  17. Var SourceName : strg40;
  18.     Eingabe    : Char;
  19.     Liste      : Text;
  20.     Filenamen  : Array [1..50] of strg40;
  21.     Anz_Files  : Integer;
  22.     Bild       : Integer;
  23.     Abbruch    : Boolean;
  24.  
  25.  
  26.  
  27. procedure HGCgrafmode;
  28. const ysync = $58;
  29.       modus : array [0..11] of byte
  30.             = ($36, $2D, $2F, $07, $5B, $00, $58,
  31.                ysync, $02, $03, $00, $00);
  32. var   reg   : byte;
  33. Begin
  34.   port [$03BF] := 3;
  35.   for reg := 0 to 11 do Begin
  36.                           port [$03B4] := reg;
  37.                           port [$03B5] := modus [reg];
  38.                         End;
  39.   Inline ($BA/$BA/$03/$EC/$24/$80/$E1/$FB);
  40.   port [$03B8] := $0A;
  41.   port [$03BF] := $03;
  42.   fillchar (mem [grafbase:0000],$7FFF,0);
  43. End;
  44.  
  45.  
  46.  
  47.  
  48.  
  49. Procedure HGCtextmode;
  50. var register : record
  51.                  ax, bx, cx, dx, bp,
  52.                  di, si, ds, es, flags : integer;
  53.                end;
  54. Begin
  55.   with register do Begin
  56.                      ax := 7;
  57.                      intr ($10, register);
  58.                    End;
  59. End;
  60.  
  61.  
  62.  
  63.  
  64.  
  65. Procedure Warte (Zeit : Integer);
  66. Var I : Integer;
  67.     Z : Char;
  68. Begin
  69.   If Zeit > 30 then Zeit := 30;
  70.   I := 1;
  71.   Repeat
  72.     delay (8);
  73.     I := I + 1;
  74.   Until (I > (Zeit * 100)) or keypressed;
  75.   While keypressed do Read (KBD, Z);
  76.   If (Z = #27) then Abbruch := TRUE
  77.                else Abbruch := FALSE;
  78. End;
  79.  
  80.  
  81.  
  82.  
  83.  
  84. Procedure Bild_laden (Filename : strg40);
  85. const Bildgroesse = 256;
  86. var Zeiger_Byte : ^Byte;
  87.     Bilddatei   : File;
  88. Begin
  89.   Zeiger_Byte := Ptr (GrafBase,$0000);
  90.   Assign (Bilddatei, Filename);
  91.   {$I-}
  92.   Reset (Bilddatei);
  93.   {$I+}
  94.   If IOresult = 0 then Begin
  95.                          BlockRead (Bilddatei,Zeiger_Byte^,Bildgroesse);
  96.                          Close (Bilddatei);
  97.                        End;
  98. End;
  99.  
  100.  
  101.  
  102.  
  103.  
  104. Begin
  105.   ClrScr;
  106.   Assign (liste, 'INHALT');
  107.   {$I-}
  108.   Reset (liste);
  109.   {$I+}
  110.   If IOresult = 0
  111.     then Begin
  112.            Anz_Files := 0;
  113.            Repeat
  114.              Anz_Files := Anz_Files + 1;
  115.              Readln (liste, Filenamen [Anz_Files]);
  116.            Until Eof (liste);
  117.            ClrScr;
  118.            HGCgrafmode;
  119.            Repeat
  120.              For Bild := 1 to Anz_Files do
  121.                If not Abbruch then Begin
  122.                                      Bild_laden (Filenamen [Bild]);
  123.                                      Warte (30);
  124.                                    End;
  125.            Until Abbruch;
  126.            HGCtextmode;
  127.            ClrScr;
  128.          End
  129.     else Write ('Fehler beim Öffnen der Datei "INHALT" !',#7);
  130. End.
  131.  
  132.  
  133. ə